home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / mar93.zip / TIP855.LSP < prev    next >
Lisp/Scheme  |  1993-02-13  |  5KB  |  156 lines
  1. ; TIP855: THREADS.LSP (c)1993, Paul Davisson
  2.  
  3. ; This routine draws any unified screw thread profile 
  4. ; which includes the following; coarse thread series
  5. ; (unc/unrc), fine thread series (unf/unrf), extra fine
  6. ; thread series (unef/unref), and selected combinations
  7. ; (uns/unrs).  The program prompts for the style
  8. ; of thread (you need only enter whether it is a 
  9. ; "un" or "unr" series of thread, the default is "un".), 
  10. ; the pitch diameter, number of threads per inch,
  11. ; the approximate length of thread desired, and the
  12. ; insertion point on the drawing.  Note the  
  13. ; approximate length is used because the thread is 
  14. ; constructed in a manner that the length is derived
  15. ; using increments of thread pitch.  The user can trim the 
  16. ; thread to the length desired.
  17.  
  18. ;                               Paul Davisson   
  19. ;                               Nelson Irrigation Corp.
  20. ;                               Walla Walla, Wa. 99362
  21.  
  22.  
  23. (setq ANS 
  24.    (getstring "unr or un thread series?    UNR or <UN>:   ")
  25.  
  26.       PIT
  27.                 (getreal "enter pitch diameter:   ")
  28.  
  29.       TI
  30.                 (getreal "enter threads per inch:   ")
  31.  
  32.       TL
  33.    (getreal "enter approximate length of thread desired:  ")
  34.  
  35.       SP
  36.                 (getpoint "select insertion point")
  37. )
  38.  
  39.  
  40. (cond ((= ANS "UN")(setq Q 0.0))
  41.       ((= ANS "UNR")(setq Q 1.0))
  42.       ((= ANS "unr")(setq Q 1.0))
  43.       ((= ANS "un")(setq Q 0.0))
  44.       ((= ANS  )(setq Q 0.0))
  45. )
  46.  
  47.  
  48. (setq P     (/ 1.0 TI)    
  49.                ; derives thread pitch
  50.    
  51.  
  52.       TLL   (fix (/ TL P))     
  53.                ; takes desired approximate thread length and     
  54.                ; associates it with the number of threads  
  55.                ; per inch and makes it an intiger
  56.    
  57.  
  58.  
  59.       H     (/(* 0.125 P (cos (/ PI 6.0)))
  60.               (* 0.25 (sin (/ PI 6.0))))
  61.                ; literal peak to peak thread height
  62.     
  63.  
  64.       MAJ   (+ PIT (* 0.375 2.0 H)) 
  65.                ; major diameter
  66.     
  67.       MIN   (- MAJ (* 2.0 0.625 H))
  68.                ; minor diameter for "un" series
  69.     
  70.       MINR   (- MIN (* H 0.125))
  71.                ; minor diameter for "unr" series 
  72.  
  73.       HMJ   (/ MAJ 2.0)
  74.                ; major radius
  75.  
  76.       HMN   (/ MIN 2.0)
  77.                ; minor radius for "un" series
  78.     
  79.       HMNR  (/ MINR 2.0)
  80.                ; minor radius for "unr" series
  81.  
  82.       DIFY  (/ (* (- HMJ HMN) (sin (/ PI 6.0)))
  83.                              (cos (/ PI 6.0)))
  84.                ; major minor difference in y dir for 
  85.                ; "un" series
  86.     
  87.  
  88.       PA    (* 0.0625 P)
  89.                ; one half width of thread crest
  90.     
  91.       A     (list (+ HMJ (car SP))(cadr SP))
  92.       B     (list (car A)(-(cadr A) PA))
  93.       C     (list (+ HMN (car SP))(-(cadr B) DIFY))
  94.       D     (list (car C)(-(cadr A)(* 0.5 P)))
  95.       E     (list (car D)(-(cadr D)(distance C D)))
  96.       F     (list (car A)(-(cadr E) DIFY))
  97.       G     (list (car F)(-(cadr F) PA))
  98.       AA    (list (-(car SP) HMN)(cadr A))
  99.       BB    (list (car AA)(- (cadr SP) (distance C D)))
  100.       CC    (list (-(car SP) HMJ)(-(cadr BB) DIFY)) 
  101.       DD    (list (car CC)(-(cadr CC) PA))
  102.       EE    (list (car DD)(-(cadr DD) PA))
  103.       FF    (list (car AA)(-(cadr EE) DIFY))
  104.       GG    (list (car FF)(-(cadr FF) (distance C D)))
  105.       I     (list (+ (car SP) HMNR)(- (cadr C)
  106.                   (* 0.108 P (cos (/ PI 6.0)))))
  107.       J     (list (car I)(cadr D))
  108.       K     (list (car I)(- (cadr I)(* 2.0 (distance I J))))
  109.       L     (list (- (car SP) HMNR)(- (cadr SP)
  110.                   (distance I J)))
  111.       M     (list (- (car SP) HMNR)(cadr SP))
  112.       N     (list (car M)(- (cadr FF) (* 0.108 P 
  113.                   (cos (/ PI 6.0)))))
  114.       O     (list (car M)(-(cadr N) (distance I J)))
  115. )
  116.  
  117.  
  118. (if (= Q 1.0) (command "pline" M "W" 0.0 ""
  119.             L "A" BB "L" CC DD A B C "A" I "L" J O
  120.                   N "A" FF "L" EE DD ""
  121.  
  122.          "array" (ssget "l") "" "r" TLL 1 (- P) 
  123.  
  124.          "pline" J K "A" E "L" F G ""
  125.  
  126.          "array" (ssget "l") "" "r" TLL 1 (- P)
  127.  
  128.          "line" A M ""
  129.  
  130.          "array" (ssget "l") "" "r" 2 1 (- (* TLL P) )
  131.                 )  
  132.                  ; routine for "unr" series 
  133.      
  134.  
  135.  
  136.           (command "pline" AA "w" 0.0 ""
  137.                     BB CC EE FF GG D C B A DD ""
  138.            
  139.           "array" (ssget "l") "" "r" TLL 1 (- P)
  140.  
  141.           "pline" D E F G ""
  142.  
  143.           "array" (ssget "l") "" "r" TLL 1 (- P)
  144.  
  145.           "line" A AA ""
  146.  
  147.           "array" (ssget "l") "" "r" 2 1 (- (* TLL P) ))
  148. )              
  149.                  ; routine for "un" series  
  150.  
  151. (command  "line" (list (car SP) (+ (* PIT 0.1) (cadr SP)))
  152.                  (list (car SP) (- (cadr SP) (+ (* TLL P)
  153.                        (* PIT 0.1)))) "" )
  154.                  ; routine for centerline
  155.  
  156.